package Farsail;

use strict; 
use warnings;

use Carp;

use Data::Dumper qw(Dumper);
$Data::Dumper::Indent = 1;
use base 'Class::Singleton';
use Farsail::Config;
use Farsail::Args;
use Farsail::ActionSet;
use Farsail::PBS;
use Farsail::DBI;
use subs 'log', 'system';

use version; our $VERSION = qv("1.5.2_2");

sub log {
    my $self = shift;
    if ( $self->{logger} ) {
        if ( $self->{logger}->isa('Log::Log4perl::Logger')  ) {
            $self->{logger}->info(join(" ", @_));
        } elsif ( $self->{logger}->can('log') ) {
            $self->{logger}->log(@_);
        } else {
            print "@_\n";
        }
    }
}

# overload for fake option
sub system {
    my $self = shift;
    return CORE::system(@_);
}
    
sub config {
    my $self = shift;
    unless ( exists $self->{config} ) {
        unless ( $ENV{FARSAILDIR} ) {
            confess "Please set environment variable FARSAILDIR first.\n";
        }
        $self->{config} = Farsail::Config->new($ENV{FARSAILDIR});
    }
    return $self->{config};
}

sub args {
    my $self = shift;
    unless ( exists $self->{args} ) {
        $self->{args} = Farsail::Args->new;
    }
    return $self->{args};
}

sub actions {
    my $self = shift;
    unless ( exists $self->{actions} ) {
        $self->{actions} = Farsail::ActionSet->new($self->config);
    }
    return $self->{actions};
}

sub init {
    my $self = shift;
    my $config = $self->config;
    my $actions = $self->actions;
    my $args = $self->args;
    my @args = @ARGV;
    $args->define(
        split /\s*,\s*/, $config->global_arguments
    );
    $args->getopt('pass_through', \@args);
    if ( $actions->has_action($args[0]) ) {
        $self->{action} = shift @args;
    }
    $args->define('other_args=s');
    $self->{action_args} = \@args;
}

sub logger {
    my $self = shift;
    if ( @_ ) {
        $self->{logger} = shift;
    }
    return $self->{logger};
}

sub easy_init {
    my $self = shift;
    my $config = $self->config;
    my $args = $self->args;
    $self->init(@_);
    if ( $args->fake ) {
        require Farsail::Mock;
        Farsail::Mock->import(qw/DBI PBS open system/);
    }
    unless ( $self->{action} && $self->{action} eq 'help' ) {
        require Log::Log4perl;
        Log::Log4perl->init(\$config->log4perl);
        $self->logger( Log::Log4perl->get_logger() );
    }
}

sub set_args {
    my $self = shift;
    my $action = shift;
    my %opts = @_;
    my $args = $self->args;
    my @other_args = @{$self->{action_args}};
    my $action_args = $self->actions->args($action);
    foreach my $name ( keys %$action_args ) {
        $args->define($name, $action_args->{$name});
    }
    $args->getopt(\@other_args);
    $args->set('other_args', \@other_args);
    for ( keys %opts ) {
        if ( $_ eq 'other_args' ) {
            my $old = $args->get('other_args');
            push @$old, @{$opts{$_}};
        } else {
            $args->set($_, $opts{$_});
        }
    }
}

sub load_modules {
    my $self = shift;
    my $inc = $self->{INC} ||= {};
    my @modules = @_;
    for my $module( @modules ) {
        next if exists $inc->{$module};
        eval( "require $module" );
        if ( $@ ) {
            confess "Require $module failed: $@\n";
        }
        $inc->{$module}++;
        if ( $module->can('init') ) {
            $module->init($self);
        }
    }
}

sub _is_interactive {
    return -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; # Pipe?
}

# NOTE this is a blocking operation if(-t STDIN)
sub _is_unattended {
    my $self = shift;
    if ( $self->args->ni ) {
        return 1;
    }
    return $ENV{PERL_MM_USE_DEFAULT}
        || ( !$self->_is_interactive && eof STDIN );
}

sub _readline {
    my $self = shift;
    return undef if $self->_is_unattended;

    my $answer = <STDIN>;
    chomp $answer if defined $answer;
    return $answer;
}

sub prompt {
    my $self = shift;
    my $mess = shift
        or die "prompt() called without a prompt message";

    # use a list to distinguish a default of undef() from no default
    my @def;
    @def = (shift) if @_;

    # use dispdef for output
    my @dispdef
        = scalar(@def)
        ? ( '[', ( defined( $def[0] ) ? $def[0] . ' ' : '' ), ']' )
        : ( ' ', '' );

    local $| = 1;
    print "$mess ", @dispdef;

    if ( $self->_is_unattended && !@def ) {
        die <<EOF;
ERROR: This build seems to be unattended, but there is no default value
for this question.  Aborting.
EOF
    }

    my $ans = $self->_readline();

    if (!defined($ans)    # Ctrl-D or unattended
        or !length($ans)
        )
    {                     # User hit return
        print "$dispdef[1]\n";
        $ans = scalar(@def) ? $def[0] : '';
    }

    return $ans;
}

sub y_n {
    my $self = shift;
    my ( $mess, $def ) = @_;

    die "y_n() called without a prompt message" unless $mess;
    die "Invalid default value: y_n() default must be 'y' or 'n'"
        if $def && $def !~ /^[yn]/i;

    my $answer;
    while (1) {    # XXX Infinite or a large number followed by an exception ?
        $answer = $self->prompt(@_);
        return 1 if $answer =~ /^y/i;
        return 0 if $answer =~ /^n/i;
        local $| = 1;
        print "Please answer 'y' or 'n'.\n";
    }
}

sub current_action { return shift->{action} }
sub invoked_action { shift->{invoked_action} }

sub dispatch {
    my $self = shift;
    local $self->{_completed_actions} = {};
    local $self->{args} = $self->{args}->clone;
    my $action;
    if ( @_ ) {
        $action = shift;
    } else {
        $action = $self->{action};
        confess "No action specified" unless $action;
    }
    my $actions = $self->actions;
    
    if ( my $farsail_action = $actions->action($action) ) {
        local $self->{invoked_action} = $farsail_action;
        $self->set_args($farsail_action, @_);
        $self->load_modules( keys %{$actions->requires($farsail_action)} );
        $self->_call_action($farsail_action);
    } else {
        confess "Unknown action '$action'!\n";
    }
}

sub _call_action {
    my ($self, $action) = @_;
    
    if ( !ref $action ) {
        $action = $self->actions->action($action);
    }
    return if $self->{_completed_actions}{$action->full_name}++;
    $self->log($action, "START");
    local $self->{action} = $action;
    my $module = $action->module;
    if ( $action->check ) {
        my $method = 'CHECK_' . $action->check;
        if ( $module && $module->can($method) ) {
            if ( $module->$method() ) {
                $self->log($action, 'SKIP');
                return;
            } 
        } else {
            $self->log($action, "WARNNING",  "${module}::$method not found!");
        }
    }
    my $method = "ACTION_".$action->name;
    $self->depends_on($action->depends);
    if ( $module && $module->can($method) ) {
        $module->$method();
    }
    $self->log($action, "END");
}

sub depends_on {
    my $self = shift;
    my $actions = $self->actions;
    my $current_ns = $self->current_action->namespace;
    foreach my $action (@_) {
        $self->_call_action(
            $actions->action($action, $current_ns)
        );
    }
}

sub db_connect {
    my $self = shift;
    my $db_id = shift || return;
    if ( exists $self->{databases}{$db_id} ) {
        return $self->{databases}{$db_id};
    }
    my $dbconf = $self->config->database($db_id);
    if ( !$dbconf ) {
        confess "Unknown database '$db_id'\n";
    }
    my $dbh = $self->{databases}{$db_id} = Farsail::DBI->connect(
        $dbconf->dsn, $dbconf->user, $dbconf->password, @_
    );
    if ( $dbconf->{dbd} eq 'Pg' ) {
        my $pid = $dbh->selectall_arrayref("SELECT pg_backend_pid()");
        $self->log($self->current_action, "CONNECT", "$db_id, $pid->[0][0]") if @$pid;
    } else {
        $self->log($self->current_action, "CONNECT", "$db_id");
    }
    return $dbh;
}

sub db_disconnect {
    my $self = shift;
    my $db_id = shift;
    my $dbh = delete $self->{databases}{$db_id};
    if ( $dbh ) {
        return $dbh->disconnect;
    }
}

sub db {
    my $self = shift;
    return $self->db_connect(@_)
}

sub cluster_connect {
    my $self = shift;
    my $cluster_name = shift;
    my $cluster = $self->config->cluster($cluster_name);
    if ( !$cluster ) {
        confess "Unknown cluster '$cluster_name'\n";
    }
    return $self->db_connect($cluster->{proxy}, @_);
}

sub cluster {
    my $self = shift;
    my $cluster_name = shift;
    return $self->cluster_connect($cluster_name);
}

sub cluster_disconnect {
    my $self = shift;
    my $cluster_name = shift;
    my $cluster = $self->config->cluster($cluster_name);
    if ( !$cluster ) {
        confess "Unknown cluster '$cluster_name'\n";
    }
    return $self->db_disconnect($cluster->{proxy});
}

sub pbs {
    my $self = shift;
    my $pbs = $self->config->pbs;
    my $queue = shift || $pbs->{queue};
    return Farsail::PBS->new($queue);
}

1;
